home *** CD-ROM | disk | FTP | other *** search
/ CD/PC Actual 1 / PC Actual CD 01.iso / f1 / mdisk25.arj / MCOPY.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-09-27  |  23.1 KB  |  599 lines
  1. {$A+,B-,D-,E-,F-,G+,I+,L-,N-,O-,R-,S-,V+,X-}
  2.  
  3. { Módulo de la copia de disquetes }
  4. { (c) Emilio David Diaus 1994 }
  5.  
  6. {
  7. Mcopy - NΘCleo De La Copia De Disquetes.
  8.      A TravéS De Mcopy Se Realiza El Copiado De Disquetes Propiamente Dicho, Mcopy Es Una
  9. Unidad Que Entra En Funcionamiento Por Medio Del Procedimiento Copy_Disk Llamado Por Mprog
  10. En Handleevent.
  11.      En Mcopy Se Crea Un Nuevo Objeto De DiáLogo Dependiente De Tdialog Que Se Encargará
  12. De Copiar Los Disquetes. A Copy Disk Se Le Pasan Tres ParáMetros Obtenidos Previamente En
  13. Mprog: NúMero De La Unidad De Disquete A Procesar, NúMero De Copias Que Se Van A Hacer y
  14. Si Se Van A Verificar Las Copias O No.
  15.      Para Usar Un DiáLogo Como Sistema Para Copiar Disquetes He Tenido Que Modificar El
  16. MéTodo Execute Para Adaptarlo A Mis Necesidades. El MéTodo Execute Consta De Un Bucle
  17. Donde Se Procesan Los Diversos Sucesos, En Mi MéTodo Execute Hay Dos Bucles Que Coinciden
  18. Con La Lectura Y Con La Escritura Del Disquete Y De Los Que Se Sale Por Medio De Handlevent Que
  19. Procesa El Suceso Si Hemos Pulsado Esc O Hemos Activado AlgúN Comando De Cerrar La Ventana
  20. Mediante El RatóN O Alt-F3, AdemáS Se Encarga De Analizar El Disquete Introducido Desechando
  21. Los Disquetes ErróNeos, Actualiza El Sistema De Ayuda Para Poder Ser Utilizado Con La GestióN De
  22. Errores ,Contabilizar El Progreso De La Copia Y El Tiempo De La Misma.
  23.      Para Saber Donde Se Va A Colocar La Imagen Del Disquete Existe El Tipo Tplace Y La Variable
  24. Where Y Su Funcionamiento Es El Siguiente: Primero Se Comprueba Si Hay Memoria Extendida,
  25. Si La Hay Se Utiliza Esta Y A La Variable Where Se Le Asigna El Valor In_Xms, Si No Hay Suficiente
  26. Memoria Extendida Se Prueba Con La Memoria Expandida Y Si Hay Suficiente Se Asigna A Where
  27. El Valor In_Ems, Por úLtimo Si No Hay Suficiente Memoria Extendida Ni Expandida Se Utiliza El
  28. Disco Duro Y La Imagen Se Coloca En El Mismo Directorio Donde Se Ejecuta El Programa En El
  29. Fichero Disk.Dat Que Al Finalizar El Programa Se Borra.
  30.      Utiliza El Programa Mas Memoria De La Que Se Necesita Como Un Sistema De Seguridad,
  31. Para Eso Está La Variable Mempool Que Aloja 16 Kb MáS De Memoria.
  32.      La Copia De Disquetes Se Puede Interrumpir En Cualquier Momento Por Medio De La Tecla
  33. De Esc O Pulsando Con El RatóN En El Icono De Cerrar Del DiáLogo Situado En La Esquina Superior
  34. Izquierda Del Mismo.
  35.      Los MóDulos Que Utiliza El Programa Son Los Siguientes:
  36.      Dos,Crt,Emimsbox,Objects,Drivers,Views,Dialogs,Emiapp,Mdhelp - Para La GestióN De La
  37.      PresentacióN Y De Los DiáLogos Y Objetos Visuales Y Las Definiciones De Ayuda Y Sucesos
  38.      Del Programa.
  39.      Mdrive - MóDulo Que Da Soporte A Las Funciones Bios De Manejo De Disquetes.
  40.      Timer - MóDulo Para Contar El Tiempo.
  41.      Mxmsst - MóDulo Para La CreacióN De Un Flujo O Tstream Que Utiliza Memoria Extendida.
  42.      Ahora Voy A Describir Los Procedimientos MáS Importantes De Copydlg, Puesto Que Los
  43. Procedimientos Derivados EstáNdar Han Sido Explicados Con Anterioridad No Los Trataré Ahora:
  44.      Procedure Draw - Dibuja El DiáLogo Que Es El áRea De Trabajo Del Programa.
  45.      Procedure Read_Floppy - Lee El Disquete Fuente.
  46.      Procedure Write_Floppy - Escribe Mediante Un Bucle Los Disquetes De Destino.
  47.      Procedure Get_Real_Time - Obtiene El Tiempo Real De Copia.
  48.      Procedure Get_Estimated_Time(Track:Byte) - Obtiene El Tiempo Estimado De Copia.
  49.      Procedure Updating - Actualiza Algunos Datos Del DiáLogo.
  50.      Function Execute:Word - EfectúA El Copiado De Los Disquetes.
  51.      Function Interrupcion:Boolean -Comprueba Si El Usuario Quiere De Verdad Salir Del
  52.      Programa O Ha Pulsado Esc Equivocadamente.
  53.      AdemáS De Estos Procedimientos Tenemos Las Siguientes Variables:
  54.      La Ya Mencionada Where, AdemáS De Mempool Reserva De Memoria De Seguridad De
  55.      16Kb Por Si Acaso, Estas Son Las Mas Importantes, Hay Otras De Menor Importancia.
  56.      El Programa Detecta Los Errores De Disquete E Interrumpe La Copia Si Es Necesario.
  57.      El Programa Ha Sido Realizado De Modo Que Sea En Execute Donde Se Realice Realmente
  58.      La Copia Del Disquete, En Otros Casos Se Emplea Un Bucle Para La GestióN De Los Sucesos,
  59.      Pero Como Aquí Execute Tiene Dos Partes, La Parte De Lectura Del Disquete Y La Parte De
  60.      Escritura, Por Eso Hay Dos Bucles Que Captan Las Teclas Pulsadas Por El Usuario. Para Salir
  61.      Del Programa O Bien Se Pulsa Esc O Con El RatóN Encima Del Icono De Cerrar Ventana
  62.      Situado En La Parte Superior Izquierda De Esta.
  63.      Mediante De La UtilizacióN De Un Conmutador /V El Programa Verifica Que La Copia Se Ha
  64.      Realizado Correctamente.
  65. }
  66. Unit Mcopy;
  67. Interface
  68. Uses Dos,Crt,Objects,Views,Dialogs,Emiapp,Mdrive,Drivers,Mdhelp;
  69. Const Cmempool=1024*16;  { Salvaguardia de memoria       }
  70.       Fpverify   = $001; { FpXXXX= Banderas del programa }
  71.       Fptofile   = $002;
  72.       Fpfromfile = $004;
  73.  
  74. Type Tplace=(Nowhere,In_Hard_Disk,In_Xms,In_Ems); { Tipo ¿Donde copiamos? }
  75.  
  76. Type Pcopydlg=^Copydlg;
  77.      Copydlg=Object(Tdialog) { Díalogo de copia }
  78.  
  79.        Disk              :  Tdrive; { Objeto que maneja el disquete }
  80.        Where             :  Tplace; { ¿Donde copiamos? }
  81.        Bo_Exit_Dlg       : Boolean; { ¿Salir? }
  82.        Wnumber_Of_Tracks,
  83.        Wflags            :    Word; { Banderas de acciones }
  84.        Lglobal_Time,                { El tiempo }
  85.        Bdrive_Number     :    Byte;
  86.        Ltotal_Copies,
  87.        Lcopies_Done      : Longint; { Las copias }
  88.        Apar              : Array[0..2] Of Longint;
  89.                          { Para visualizar parámetros }
  90.        Fout              : Pstream;
  91.                          { Flujo donde colocar la imagen del disquete }
  92.        Ev                : Tevent; { Sucesos }
  93.        Sfile_Name        : String;
  94.                          { Fichero donde puede ir la imagen del disquete }
  95.  
  96.        Constructor Init(Var Vcbounds: Trect; Vctitle: Ttitlestr;Vcbdrive: Byte;Vcicopies:Integer;
  97.        Vcwflags:Word;Vcsfile:String);
  98.  
  99.        Procedure Read_Floppy;
  100.        Procedure Write_Floppy;
  101.  
  102.        Procedure Get_Real_Time;
  103.        Procedure Get_Estimated_Time(Btrack:Byte);
  104.        
  105.        Function Interrupcion:Boolean;
  106.  
  107.        Procedure Draw;Virtual;
  108.        Procedure Updating;
  109.        Function Execute:Word;Virtual;
  110.  
  111.        Procedure Handleevent(Var Event:Tevent);Virtual;
  112.  
  113.        Destructor Done;Virtual;
  114.  
  115.      End;
  116.  
  117. Procedure Copy_Disk(Vpbdrive:Byte;Vpicopies:Integer;Vpwflags:Word;Vpsfile:String);
  118.  
  119. Implementation
  120. Uses Emimsbox,Timer,Mxmsst;
  121.  
  122. Procedure Play(Vpwhz,Vpwdly:Word);
  123. Begin
  124.      Sound(Vpwhz);
  125.      Delay(Vpwdly);
  126.      Nosound;
  127. End;
  128.  
  129.  
  130. Procedure Copy_Disk(Vpbdrive:Byte;Vpicopies:Integer;Vpwflags:Word;Vpsfile:String);
  131. Var Wresult :     Word;
  132.     R       :    Trect;
  133.     Dlg     : Pcopydlg;
  134. Begin
  135.      Play(1000,750);
  136.      If Vpwflags And Fpfromfile=0 Then Begin
  137.         Wresult:=Messagebox(' Introduzca disquete FUENTE ',Nil,Mfconfirmation+Mfokbutton);
  138.         If Wresult In [Cmclose,Cmcancel] Then Exit;
  139.      End;
  140.      Desktop^.Getextent(R);
  141.      Inc(R.A.Y);
  142.      Dlg:=New(Pcopydlg,Init(R,'Ventana de trabajo',Vpbdrive,Vpicopies,Vpwflags,Vpsfile));
  143.      Wresult:=Desktop^.Execview(Dlg);
  144.      Dispose(Dlg,Done);
  145. End;
  146.  
  147. Constructor Copydlg.Init(Var Vcbounds: Trect; Vctitle: Ttitlestr;Vcbdrive: Byte;Vcicopies:Integer;
  148. Vcwflags:Word;Vcsfile:String);
  149. Var Sline:String;
  150. Begin
  151.      Tdialog.Init(Vcbounds,Vctitle);
  152.      Bdrive_Number:=Vcbdrive;
  153.      Ltotal_Copies:=Vcicopies;
  154.      Wflags:=Vcwflags;
  155.      Helpctx:=Hccpant;
  156.      Sline:=Getenv('TEMP');
  157.      If Sline='' Then
  158.         Getdir(0,Sline);
  159.      If Sline[Length(Sline)]<>'\' Then Sline:=Sline+'\';
  160.      If Vcsfile='' Then
  161.          Sfile_Name:=Sline+'disk.dat'
  162.         Else
  163.          Sfile_Name:=Sline+Vcsfile;
  164. End;
  165.  
  166. Procedure Copydlg.Read_Floppy;
  167.  
  168. Var Lhow_Much,
  169.     Ltrack_Size,
  170.     Lhow_Many,
  171.     Lerr_In_Track_Number : Longint;
  172.     Bposition,
  173.     Bloop                :    Byte;
  174.     Sline,Sauxline       :  String;
  175.     Wresult              :    Word;
  176.  
  177. Begin
  178.      Updating;
  179.      Inittimer(2);
  180.      Where:=In_Xms;
  181.      With Disk Do Begin
  182.           Lhow_Much:=(Longint(Disk.Sectores_Totales)*
  183.             Longint(Disk.Bytes_Por_Sector)+Cmempool);
  184.           Ltrack_Size:=Sectores_Por_Pista*Bytes_Por_Sector;
  185.      End;
  186.      If (Wflags And Fptofile=Fptofile) Or
  187.         (Wflags And Fpfromfile=Fpfromfile) Then
  188.                 Writestr(5,17,' Fichero temporal '+Sfile_Name+' ',6);
  189.      Fout:=New(Pxmsstream,Init(Lhow_Much));
  190.      Bposition:=4;
  191.      Sline:=#253;
  192.      If (@Fout=Nil) Or (Fout^.Status<>Stok) Then Begin
  193.         Fout:=New(Pemsstream,Init(Lhow_Much,Lhow_Much));
  194.         Bposition:=5;Sline:=#252;
  195.         Where:=In_Ems;
  196.      End;
  197.      If Fout^.Status<>Stok Then Begin
  198.         Fout := New(Pdosstream, Init(Sfile_Name,Stcreate));
  199.         Where:=In_Hard_Disk;
  200.         Bposition:=6;Sline:=#251;
  201.      End;
  202.      Lhow_Many:=Lhow_Much Div 1024;
  203.      Formatstr(Sauxline,'%04d',Lhow_Many);
  204.      Writestr(63,Bposition,Sauxline,11);
  205.      Wnumber_Of_Tracks:=Pred(Disk.Pistas);
  206.      Inittimer(1);
  207.      For Bloop:=0 To Wnumber_Of_Tracks Do Begin
  208.          Disk.Numero_Error:=Disk.Leepista(0,Bloop);
  209.          If (Disk.Numero_Error>0) Then Begin
  210.             Application^.Helpctx:=Hcdlectura;
  211.             Lerr_In_Track_Number:=Bloop;
  212.             Play(600,750);
  213.             Wresult:=Messagebox(' Error de lectura en pista %02d,'#13' copia abortada',
  214.             @Lerr_In_Track_Number,Mferror+Mfokbutton);
  215.             Bo_Exit_Dlg:=True;Exit;
  216.          End;
  217.          Fout^.Write(Disk.Pista,Ltrack_Size);
  218.          If Eventavail Then Begin
  219.             Getevent(Ev);
  220.             Handleevent(Ev);
  221.          End;
  222.          If (Bo_Exit_Dlg) And (Interrupcion) Then Exit;
  223.          If Bloop<=39 Then
  224.             Writechar(6,7,Sline[1],Ord(Where)*3+2,Bloop+1)
  225.          Else Begin
  226.              Writechar(6,7,Sline[1],Ord(Where)*3+2,40);
  227.              Writechar(6,10,Sline[1],Ord(Where)*3+2,Bloop+1-40);
  228.          End;
  229.          Disk.Numero_Error:=Disk.Leepista(1,Bloop);
  230.          If (Disk.Numero_Error>0) Then Begin
  231.             Application^.Helpctx:=Hcdlectura;
  232.             Lerr_In_Track_Number:=Bloop;
  233.             Play(700,750);
  234.             Wresult:=Messagebox(' Error de lectura en pista %02d,'#13' copia abortada',
  235.             @Lerr_In_Track_Number,Mferror+Mfokbutton);
  236.             Bo_Exit_Dlg:=True;Exit;
  237.          End;
  238.          Fout^.Write(Disk.Pista,Ltrack_Size);
  239.          Get_Real_Time;
  240.          Get_Estimated_Time(Bloop);
  241.      End;
  242.      If (Fout<>Nil) And (Where=In_Hard_Disk) Then
  243.         Dispose(Fout,Done);
  244. End;
  245.  
  246. Procedure Copydlg.Write_Floppy;
  247. Var Bposition,
  248.     Bloop,
  249.     Btimes               :    Byte;
  250.     Ltrack_Size          : Integer;
  251.     Sline                :  String;
  252.     Lerr_In_Track_Number,
  253.     Lhow_Much            : Longint;
  254.     Wresult              :    Word;
  255.     Fout2                : Pstream;
  256.  
  257. Begin
  258.      Disk.Numero_Error:=Disk.Verificapista(0,0);
  259.      Updating;
  260.      Inittimer(2);
  261.      Ltrack_Size:=Disk.Sectores_Por_Pista*Disk.Bytes_Por_Sector;
  262.      If Wflags And Fpfromfile=Fpfromfile Then Begin
  263.         Where:=In_Hard_Disk;
  264.      End;
  265.      Case Where Of
  266.           In_Xms:Begin
  267.             Bposition:=4;Sline:=#253;
  268.           End;
  269.           In_Ems:Begin
  270.             Bposition:=5;Sline:=#252;
  271.           End;
  272.           In_Hard_Disk: Begin
  273.                Fout := New(Pdosstream, Init(Sfile_Name,Stopenread));
  274.                If (Wflags And Fpfromfile=Fpfromfile) Then Begin
  275.                   Lhow_Much:=Longint(Disk.Sectores_Totales)*Longint(Disk.Bytes_Por_Sector) Div 1024;
  276.                   Formatstr(Sline,'%04d',Lhow_Much);
  277.                   Bposition:=6;
  278.                   Writestr(63,Bposition,Sline,11);
  279.                   Sline:=#251;
  280.                End;
  281.           End;
  282.      End;
  283.      If (Wflags And Fptofile=Fptofile) Or
  284.         (Wflags And Fpfromfile=Fpfromfile) Then
  285.                 Writestr(5,17,' Fichero temporal '+Sfile_Name+' ',6);
  286.      Inittimer(1);
  287.      Fout^.Seek(0);
  288.      For Bloop:=0 To Wnumber_Of_Tracks Do Begin
  289.          Fout^.Read(Disk.Pista,Ltrack_Size);
  290.          Disk.Numero_Error:=Disk.Grabapista(0,Bloop);
  291.          If Eventavail Then Begin
  292.             Getevent(Ev);
  293.             Handleevent(Ev);
  294.          End;
  295.          If (Bo_Exit_Dlg) And (Interrupcion) Then Exit;
  296.          Btimes:=1;
  297.          While (Disk.Numero_Error<>0) And (Btimes<3) Do Begin
  298.                Disk.Numero_Error:=Disk.Format(0,Bloop);
  299.                If Bloop<=39 Then
  300.                   Writechar(6+Bloop,7,'O',11,1)
  301.                Else
  302.                   Writechar(6+Bloop-40,10,'O',11,1);
  303.                Disk.Numero_Error:=Disk.Grabapista(0,Bloop);
  304.                Inc(Btimes);
  305.          End;
  306.          If Wflags And Fpverify=Fpverify Then
  307.                   Disk.Numero_Error:=Disk.Verificapista(0,Bloop);
  308.          If (Disk.Numero_Error>0) And (Btimes>=3) Then Begin
  309.             Lerr_In_Track_Number:=Bloop;
  310.             Play(700,750);
  311.             Wresult:=Messagebox(' Error de escritura en pista %02d,'#13' copia abortada',
  312.             @Lerr_In_Track_Number,Mferror+Mfokbutton);
  313.             Bo_Exit_Dlg:=True;Exit;
  314.          End;
  315.          Fout^.Read(Disk.Pista,Ltrack_Size);
  316.          If Bloop<=39 Then
  317.             Writechar(6,7,Sline[1],Ord(Where)*2-1,Bloop+1)
  318.          Else Begin
  319.              Writechar(6,7,Sline[1],Ord(Where)*2-1,40);
  320.              Writechar(6,10,Sline[1],Ord(Where)*2-1,Bloop+1-40);
  321.          End;
  322.          Disk.Numero_Error:=Disk.Grabapista(1,Bloop);
  323.          If Eventavail Then Begin
  324.             Getevent(Ev);
  325.             Handleevent(Ev);
  326.          End;
  327.          If (Bo_Exit_Dlg) And (Interrupcion) Then Exit;
  328.          Btimes:=1;
  329.          While (Disk.Numero_Error<>0) And (Btimes<3) Do Begin
  330.                Disk.Numero_Error:=Disk.Format(1,Bloop);
  331.                If Bloop<=39 Then
  332.                   Writechar(6+Bloop,7,'O',11,1)
  333.                Else
  334.                   Writechar(6+Bloop-40,10,'O',11,1);
  335.                Disk.Numero_Error:=Disk.Grabapista(1,Bloop);
  336.                Inc(Btimes);
  337.          End;
  338.          If Wflags And Fpverify=Fpverify Then
  339.                   Disk.Numero_Error:=Disk.Verificapista(0,Bloop);
  340.          If (Disk.Numero_Error>0) And (Btimes>=3) Then Begin
  341.             Lerr_In_Track_Number:=Bloop;
  342.             Play(700,750);
  343.             Wresult:=Messagebox(' Error de escritura en pista %02d,'#13'copia abortada',
  344.             @Lerr_In_Track_Number,Mferror+Mfokbutton);
  345.             Bo_Exit_Dlg:=True;Exit;
  346.          End;
  347.          Get_Real_Time;
  348.          Get_Estimated_Time(Bloop);
  349.      End;
  350.      If (Fout<>Nil) And (Where=In_Hard_Disk) Then Dispose(Fout,Done);
  351.      If Not(Where=In_Hard_Disk) And (Wflags And Fptofile=Fptofile) Then Begin
  352.         Writestr(5,17,' Creando fichero temporal '+Sfile_Name+' ... ',1);
  353.         Fout2:=New(Pdosstream,Init(Sfile_Name,Stcreate));
  354.         Fout^.Seek(0);
  355.         Lhow_Much:=Longint(Disk.Sectores_Totales)*Longint(Disk.Bytes_Por_Sector);
  356.         Fout2^.Copyfrom(Fout^,Lhow_Much);
  357.         Dispose(Fout2,Done);
  358.      End;
  359. End;
  360.  
  361. Procedure Copydlg.Get_Real_Time;
  362. Var Wh,Wm,Ws,Wcs :   Word;
  363.     Sline        : String;
  364.  
  365. Begin
  366.          Get_Timer_Vars(2,Wh,Wm,Ws,Wcs);
  367.          Apar[0]:=Wm;
  368.          Apar[1]:=Ws;
  369.          Apar[2]:=Wcs;
  370.          Formatstr(Sline,'%02d:%02d.%02d',Apar);
  371.          Writestr(7,15,Sline,26);
  372. End;
  373.  
  374. Procedure Copydlg.Get_Estimated_Time(Btrack:Byte);
  375. Var Wh,Wm,Ws,Wcs    :    Word;
  376.     Ltime           : Longint;
  377.     Bdisks_Per_Hour :    Byte;
  378.     Sline           :  String;
  379. Begin
  380.          Get_Timer_Vars(1,Wh,Wm,Ws,Wcs);
  381.          Ltime:=(Rtimer[1] Div (Btrack+1))*80;
  382.          If Ltime=Lglobal_Time Then Exit;
  383.          Bdisks_Per_Hour:=3600 Div (Ltime Div 100);
  384.          Wh:=Word(Ltime Div 360000);
  385.          Ltime:=Word(Ltime Mod 360000);
  386.          Wm:=Word(Ltime Div 6000);
  387.          Ltime:=Word(Ltime Mod 6000);
  388.          Ws:=Word(Ltime Div 100);
  389.          Ltime:=Word(Ltime Mod 100);
  390.          Wcs:=Ltime;
  391.          Apar[0]:=Wm;
  392.          Apar[1]:=Ws;
  393.          Apar[2]:=Wcs;
  394.          Formatstr(Sline,'%02d:%02d.%02d',Apar);
  395.          Writestr(18,15,Sline,26);
  396.          Apar[0]:=Bdisks_Per_Hour;
  397.          Formatstr(Sline,' %03d ',Apar);
  398.          Writestr(35,15,Sline,26);
  399.          Lglobal_Time:=Ltime;
  400. End;
  401.  
  402. Function Copydlg.Interrupcion:Boolean;
  403. Var Wresult : Word;
  404. Begin
  405.      Interrupcion:=False;
  406.      Play(1200,750);
  407.      Wresult:=Messagebox(' Seleccione CANCELAR para continuar la copia o SI para salir del programa.',
  408.      Nil,Mfyesbutton+Mfcancelbutton+Mfconfirmation);
  409.      If Not (Wresult In [Cmclose,Cmcancel]) Then
  410.         Interrupcion:=True
  411.      Else
  412.          Bo_Exit_Dlg:=False;
  413. End;
  414.  
  415. Procedure Copydlg.Draw;
  416.  
  417. Type Eframe=String[8];
  418.  
  419. Const
  420.   Cdoubleframe  : Eframe  = #201#205#187#186#186#200#205#188;
  421.   Csingleframe  : Eframe  = #218#196#191#179#179#192#196#217;
  422.  
  423. Var Bloop:Byte;
  424.  
  425.  
  426. Procedure Writerect(Vpiix,Vpiiy,Vpifx,Vpify:Integer;Frame:Eframe;Bcolor:Byte);
  427. Var Bloop:Byte;
  428. Begin
  429.      Writechar(Vpiix,Vpiiy,Frame[1],Bcolor,1);
  430.      Writechar(Vpiix+1,Vpiiy,Frame[2],Bcolor,Vpifx-Vpiix-1);
  431.      Writechar(Vpifx,Vpiiy,Frame[3],Bcolor,1);
  432.      Writechar(Vpiix,Vpify,Frame[6],Bcolor,1);
  433.      Writechar(Vpiix+1,Vpify,Frame[7],Bcolor,Vpifx-Vpiix-1);
  434.      Writechar(Vpifx,Vpify,Frame[8],Bcolor,1);
  435.      For Bloop:=Vpiiy+1 To Vpify-1 Do Begin
  436.          Writechar(Vpiix,Bloop,Frame[4],Bcolor,1);
  437.          Writechar(Vpiix+1,Bloop,#32,Bcolor,Vpifx-Vpiix-1);
  438.          Writechar(Vpifx,Bloop,Frame[4],Bcolor,1);
  439.      End;
  440. End;
  441.  
  442. Begin
  443.      Tdialog.Draw;
  444.      Writerect(3,18,76,20,Csingleframe,19);
  445.      Writestr(4,19,' '#253'= Mem. extendida  '#252'= Mem. expandida  '#251'= Disco duro  O= Formateando',19);
  446.      Writerect(3,2,76,17,'        ',19);
  447.      Writerect(4,3,47,12,Csingleframe,21);
  448.      Writestr(6,3,' Esquema de pistas utilizadas ',21);
  449.      For Bloop:=0 To 39 Do Begin
  450.               If Bloop Mod 10=0 Then Begin
  451.                  Writechar(6+Bloop,5,Chr(Ord('0')+(Bloop Div 10)),19,1);
  452.                  Writechar(6+Bloop,8,Chr(Ord('0')+((Bloop+40) Div 10)),19,1);
  453.               End;
  454.               Writechar(6+Bloop,6,Chr(Ord('0')+(Bloop Mod 10)),19,1);
  455.               Writechar(6+Bloop,9,Chr(Ord('0')+((Bloop+40) Mod 10)),19,1);
  456.           End;
  457.           Writerect(48,3,74,7,Csingleframe,11);
  458.           Writestr(49,3,' Uso de la memoria ',11);
  459.           Writestr(50,4,'Extendida    XXXX Kb.',11);
  460.           Writestr(50,5,'Expandida    XXXX Kb.',11);
  461.           Writestr(50,6,'Disco duro   XXXX Kb.',11);
  462.           Writerect(48,8,74,16,Csingleframe,2);
  463.           Writestr(49,8,' Información del disco ',2);
  464.           Writestr(53,10,'Copias       XXX',2);
  465.           Writestr(53,11,'Copia actual XXX',2);
  466.           Writestr(53,12,'Quedan       XXX',2);
  467.           Writestr(54,14,'Tipo de unidad',2);
  468.           Updating;
  469.           Writerect(4,13,47,16,Csingleframe,25);
  470.           Writestr(6,13,' Tiempo de copia ',25);
  471.           Writestr(6,14,' Real       Estimado',25);
  472.           Writestr(6,15,' XX:XX.XX   XX:XX.XX ',26);
  473.           Writestr(30,14,' Disquetes/hora ',25);
  474.           Writestr(35,15,'<XXX>',26);
  475.           Writechar(6,7,#32,1,40);
  476.           Writechar(6,10,#32,1,40);
  477. End;
  478.  
  479. Procedure Copydlg.Updating;
  480. Var Lsize:Longint;
  481.     Sline:String;
  482. Begin
  483.           Case Disk.Tipo_Unidad Of
  484.                K360: Writestr(50,15,' 5'#172'  360Kb ',5);
  485.                K1200: Writestr(50,15,' 5'#172' 1200Kb ',5);
  486.                K720: Writestr(50,15,' 3'#171' 720Kb ',5);
  487.                K1440: Writestr(50,15,' 3'#171' 1440Kb ',5);
  488.           End;
  489.           Lsize:=(Longint(Disk.Sectores_Totales)*
  490.             Longint(Disk.Bytes_Por_Sector)) Div 1024;
  491.           Formatstr(Sline,' %4dKb',Lsize);
  492.           Writestr(63,15,Sline,2);
  493.           Lsize:=Ltotal_Copies;
  494.           Formatstr(Sline,'%03d',Lsize);
  495.           Writestr(66,10,Sline,2);
  496.           Lsize:=Lcopies_Done;
  497.           Formatstr(Sline,'%03d',Lsize);
  498.           Writestr(66,11,Sline,2);
  499.           Lsize:=Ltotal_Copies-Lcopies_Done;
  500.           Formatstr(Sline,'%03d',Lsize);
  501.           Writestr(66,12,Sline,2);
  502. End;
  503.  
  504. Function Copydlg.Execute:Word;
  505. Var Wresult,
  506.     Whlpcontext :    Word;
  507.     Icopiando   : Integer;
  508.     Sline       :  String;
  509.     
  510.  
  511. Begin
  512.      Whlpcontext:=Application^.Gethelpctx;
  513.      With Disk Do Begin
  514.           Init(Bdrive_Number);
  515.           If Numero_Error>0 Then Begin
  516.              Case Numero_Error Of
  517.                   Cerrbytessecinc,Cerrsecporclinc,
  518.                   Cerrsecporpinc,Cerrnumheadinc: Begin
  519.                      Application^.Helpctx:=Hcarranqueincorr;
  520.                      Sline:='Información del sector de arranque incorrecta.';
  521.                   End;
  522.                   Cerrdescrmedinc:Begin
  523.                      Application^.Helpctx:=Hcmedioinc;
  524.                      Sline:='Descriptor de tipo de medio no válido.';
  525.                   End;
  526.                   Cerrunidileg:Begin
  527.                      Application^.Helpctx:=Hcdilegible;
  528.                      Sline:='Unidad ilegible.';
  529.                   End;
  530.                   Cerrunidadvacia: Begin
  531.                     Application^.Helpctx:=Hcdilegible;
  532.                     Sline:='No ha introducido un disquete en la unidad.';
  533.                   End;
  534.                Else Begin
  535.                     Application^.Helpctx:=Hcdilegible;
  536.                     Sline:='Error indefinido de acceso'#13' a la unidad.';
  537.                End;
  538.              End;
  539.              Play(900,750);
  540.              Wresult:=Messagebox(Sline,Nil,Mferror+Mfokbutton);
  541.              Disk.Done;
  542.              Exit;
  543.          End;
  544.          Application^.Helpctx:=Hcdincorrec;
  545.          Numero_Error:=Definemedio(Pred(Pistas),Sectores_Por_Pista);
  546.          If Numero_Error>0 Then Begin
  547.              Play(800,750);
  548.              Wresult:=Messagebox(' Error al definir el tipo de medio para el formato. ',Nil,Mferror+Mfokbutton);
  549.              Disk.Done;
  550.              Exit;
  551.          End;
  552.      End;
  553.      Bo_Exit_Dlg:=False;
  554.      If Wflags And Fpfromfile=0 Then Read_Floppy;
  555.      Writechar(6,7,#32,1,40);
  556.      Writechar(6,10,#32,1,40);
  557.      If Bo_Exit_Dlg=False Then
  558.      For Icopiando:=1 To Integer(Ltotal_Copies) Do Begin
  559.          Lcopies_Done:=Icopiando;
  560.          Play(700,750);
  561.          Wresult:=Messagebox(' Introduzca disquete DESTINO'+#13+
  562.          ' número %03d en '+Chr(Bdrive_Number+65)+':',@Lcopies_Done,Mfconfirmation+Mfokbutton);
  563.          Application^.Helpctx:=Whlpcontext;
  564.          If Wresult In [Cmclose,Cmcancel] Then Exit;
  565.          If Bo_Exit_Dlg=False Then Write_Floppy;
  566.      End;
  567.      Application^.Helpctx:=Whlpcontext;
  568.      Disk.Done;
  569.      If Valid(Ev.Command) Then Endmodal(Ev.Command);
  570. End;
  571.  
  572. Procedure Copydlg.Handleevent(Var Event:Tevent);
  573. Begin
  574.      If (Event.Command In [Cmclose,Cmcancel]) Then Begin
  575.                        Bo_Exit_Dlg:=True;
  576.                        Clearevent(Event);
  577.         End;
  578.      If (Event.What=Evkeydown) And
  579.         (Event.Charcode=#27) Then Begin
  580.                        Bo_Exit_Dlg:=True;
  581.                        Clearevent(Event);
  582.         End;
  583.      Tdialog.Handleevent(Event);
  584. End;
  585.  
  586. Destructor Copydlg.Done;
  587. Var F:File;
  588. Begin
  589.      {$I-}
  590.      If (Fout<>Nil) And (Wflags And Fpfromfile=0) Then Dispose(Fout,Done);
  591.      If (Where=In_Hard_Disk) And (Wflags And Fptofile=0) Then Begin
  592.         Assign(F,Sfile_Name);
  593.         Erase(F);
  594.      End;
  595.      Tview.Done;
  596. End;
  597.  
  598. End.
  599.